' This is the structure of the INDEX.DDF RecLen 10 bytes
'
' keys are as follows :
' Key 0 Part 0 Non_uniq XiDFile Position 1 len 2 Ascending (int)
' Key 1 Part 0 Non-Uniq XiDField Position 3 len 2 Ascending (int)
Type XDIndexKey0_def
XiDFile As Integer
End Type
Type XDIndex_def
XiDFile As Integer ' File ID (XfDid in FILE.DDF Above)
XidField As Integer ' Filed ID (XeDid in FILED.DFF above)
XidNumber As Integer ' Key Number (0-->)
XiDPart As Integer ' Key Part (Segment of above, from 0-->)
XiDFlags As Integer ' Flags of Key
End Type
' XiDFlags can be :
' K_DUP = 1
' K_MOD = 2
' K_BIN = 4
' K_NUL = 8
' K_SEG = 16
' K_SEQ = 32
' K_DEC = 64
' K_SUP = 128
' K_EXT = 256
' K_MAN = 512
Type TempField_Def
FieldID As Integer
Position As Integer
Length As Integer
Type As Integer
End Type
Function AddRecordToFieldDDF (PosBlk As PosBlkDef, XeDFile As Integer, XeDName As String, XeDDataType As Integer, XeDOffset As Integer, XeDSize As Integer, XedDec As Integer, XeDFlags As Integer) As Integer
Dim Keybuf As KeyBufDef
Dim KeyBufLen As Integer
Dim XDField As XDField_def
Dim BufLen As Integer
Dim stat As Integer
Dim NextID As Integer
KeyBufLen = Len(Keybuf)
BufLen = Len(XDField)
stat = btrcall(B_GETHI, PosBlk, XDField, BufLen, Keybuf, KeyBufLen, 0)
If stat <> 0 Then
If stat = 9 Then
NextID = 1
Else
MsgBox "Btrieve Error Inserting Record in FILE file " & Chr(10) & stat & " " & BtErr(stat)
AddRecordToFieldDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDField, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
End If
Else
NextID = XDField.XeDid + 1
End If
status "ADDING TO FIELD.DDF WITH ID " & NextID
XDField.XeDid = NextID
XDField.XeDFile = XeDFile
XDField.XeDName = XeDName
XDField.XeDDataType = Chr(XeDDataType)
XDField.XeDOffset = XeDOffset
XDField.XeDSize = XeDSize
XDField.XedDec = Chr(XedDec)
XDField.XeDFlags = XeDFlags
KeyBufLen = Len(Keybuf)
BufLen = Len(XDField)
stat = btrcall(B_INSERT, PosBlk, XDField, BufLen, Keybuf, KeyBufLen, 0)
If stat <> 0 Then
MsgBox "Btrieve Error Inserting Record in FIELD file " & Chr(10) & stat & " " & BtErr(stat)
AddRecordToFieldDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDField, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
End If
AddRecordToFieldDDF = True
End Function
Function AddRecordToFileDDF (XFDid As Integer, PosBlk As PosBlkDef, XFDName As String, XFDLocation As String, XFDFlags As Integer, XFDReserved As String) As Integer
Dim Keybuf As KeyBufDef
Dim KeyBufLen As Integer
Dim XDfile As XDFile_def
Dim BufLen As Integer
Dim stat As Integer
Dim NextID As Integer
Dim XDFileKey0 As XDFileKey0_def
KeyBufLen = Len(Keybuf)
BufLen = Len(XDfile)
' First Find the last record used on key=0, XF$ID
If XFDid = -1 Then
BufLen = Len(XDfile): KeyBufLen = Len(Keybuf)
stat = btrcall(B_GETHI, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
If stat <> 0 Then
If stat = 9 Then
NextID = 1
Else
MsgBox "Btrieve Error Inserting Record in FILE file " & Chr(10) & stat & " " & BtErr(stat)
AddRecordToFileDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
End If
Else
NextID = XDfile.XFDid + 1
End If
status "ADDING TO FILE.DDF WITH ID " & NextID
Else
XDFileKey0.XFDid = XFDid
BufLen = Len(XDfile): KeyBufLen = Len(XDFileKey0)
stat = btrcall(B_GETEQ, PosBlk, XDfile, BufLen, XDFileKey0, KeyBufLen, 0)
If stat <> 0 Then
MsgBox "Btrieve Error Inserting Record in FILE file " & Chr(10) & stat & " " & BtErr(stat)
AddRecordToFileDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
Else
NextID = XFDid
status "UPDATING TO FILE.DDF WITH ID " & NextID
End If
End If
XDfile.XFDid = NextID
XDfile.XFDName = XFDName
XDfile.XFDLocation = XFDLocation
XDfile.XFDFlags = Chr(XFDFlags)
XDfile.XFDReserved = XFDReserved
KeyBufLen = Len(Keybuf)
BufLen = Len(XDfile)
If XFDid = -1 Then
stat = btrcall(B_INSERT, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
Else
stat = btrcall(B_UPDATE, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
End If
If stat <> 0 Then
MsgBox "Btrieve Error Inserting/Updating Record in FILE file " & Chr(10) & stat & " " & BtErr(stat)
AddRecordToFileDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDfile, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
End If
AddRecordToFileDDF = True
End Function
Function AddRecordToIndexDDF (PosBlk As PosBlkDef, XiDFile As Integer, XidField As Integer, XidNumber As Integer, XiDPart As Integer, XiDFlags As Integer) As Integer
Dim Keybuf As KeyBufDef
Dim KeyBufLen As Integer
Dim XDindex As XDIndex_def
Dim BufLen As Integer
Dim stat As Integer
' XiDFile As Integer,
' XiDField As Ingeger,
' XiDNumber As Integer,
' XiDPart As Integer,
' XiDFlags As Integer
KeyBufLen = Len(Keybuf)
BufLen = Len(XDindex)
XDindex.XiDFile = XiDFile
XDindex.XidField = XidField
XDindex.XidNumber = XidNumber
XDindex.XiDPart = XiDPart
XDindex.XiDFlags = XiDFlags
stat = btrcall(B_INSERT, PosBlk, XDindex, BufLen, Keybuf, KeyBufLen, 0)
If stat <> 0 Then
MsgBox "Btrieve Error Inserting Record in Index file" & Chr(10) & stat & " " & BtErr(stat)
AddRecordToIndexDDF = False
stat = btrcall(B_CLOSE, PosBlk, XDindex, BufLen, Keybuf, KeyBufLen, 0)
Exit Function
End If
AddRecordToIndexDDF = True
End Function
Function BtrDate (YY As Long, MM As Long, DD As Long) As Long
' converts YYMMDD into Btrieve Date type
BtrDate = YY * 65536 + MM * 256 + DD
End Function
Function BtrTime (hh As Long, MM As Long, SS As Long) As Long
BtrTime = hh * 16777216 + MM * 65536 + SS * 256
End Function
Sub Create_btrfile (XPath As String, Location As String, FileID As Integer)
Dim stat As Integer
Dim Keybuf As KeyBufDef
Dim KeyBufLen As Integer
Dim BufLen As Integer
Dim FileBuf As FileBufDef
Dim KeyNum As Integer
Dim PosBlk As PosBlkDef
Dim FileFullPath As String
Dim i As Integer
Dim XDField As XDField_def
Dim XDFieldKey1 As XDFieldKey1_def
Dim FileSize As Integer
Dim XDindex As XDIndex_def
Dim XDIndexKey0 As XDIndexKey0_def
Dim IndexLast As Integer
Dim TempField() As TempField_Def
Dim FieldLast As Integer
' I need an array to store the Field information as follows :
' FieldID .. so we can look it up with the key
' Position = ' (Start From 1 and then add length of previous field !
